home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / ladybug.arc / BCAKE.BUG next >
Encoding:
Text File  |  1984-03-14  |  1.4 KB  |  78 lines
  1. to "cake  
  2. pc 1
  3. pu setxy -200 40 pd
  4. elip 50 1
  5. seth 180 fd 80
  6. elip 50 -1
  7. seth 0 fd 80
  8. pu rt 90 fd 5 paint 3 1 back 5 pd
  9. elip 50 -1
  10. seth 180 pu fd 40 pd
  11. elip 50 -1
  12. end
  13.  
  14. to "elip  :b :ul
  15. make "a xcor
  16. make "vp ycor
  17. make "i ( -2 * :a / 40.0 )
  18. make "f1  :b * :b
  19. make "f2  :f1 /  :a / :a
  20. repeat 40 [ make "x ( xcor + :i ) make "y ( :ul * ( sqrt ( :f1 - ( :f2 * :x * :x ) + .1 ) ) + :vp ) setxy :x :y ]
  21. end
  22.  
  23. to "candle  
  24. pc 2 pd
  25. seth 0
  26. fd 80 rt 90 fd 5 lt 18 repeat 10 [ fd 4 lt 36 ] rt 18
  27. pu sety ( ycor + 3 )
  28. paint 2 2
  29. sety ( ycor - 3 ) pd
  30. fd 5 rt 90 fd 80 rt 90 fd 10
  31. pu back 5 rt 90 fd 5 paint 1 2 fd 70 paint 1 2 back 75
  32. rt 90 back 5 pd
  33. end
  34.  
  35. to "candles  :num
  36. pu setxy -205 40
  37. make "inc ( 400.0 / ( :num + 1 ) )
  38. repeat :num [ seth 90 pu fd :inc candle ]
  39. end
  40.  
  41. to "bcake  :num
  42. ;  Birthday cake is by Daniel D. Wheeler, Cincinnati, OH
  43. cs hb
  44. cake
  45. hbx
  46. candles :num
  47. hbx
  48. end
  49.  
  50. to "hbx  
  51. play "'MB O4L8 GG L4 AG O5 C L2O4 B L8 GG L4 AG O5 D L2 C O4L8 GG O5L4 GEC O4 B L2 A O5 L8 EE L4 DCD L2 C'
  52. end
  53.  
  54. to "star  :size
  55. repeat 5 [fd :size rt 144]
  56. end
  57.  
  58. to "stars  :num
  59. home cs pu
  60. repeat :num [fd 50 pd star 50 pu back 50 rt ( 360 / :num ) ]
  61. pd
  62. end
  63.  
  64. make "a "'200
  65. make "vp "'-2
  66. make "i "'-10
  67. make "f1 "'2500
  68. make "f2 "'.0625
  69. make "x "'-200
  70. make "y "'-3
  71. make "inc "'66
  72. 
  73. make "a "'200
  74. make "vp "'-2
  75. make "i "'-10
  76. make "f1 "'2500
  77. make "f2 "'.0625
  78. make